PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/appleman/eventcod.frm

Visual Basic Form | 1994-10-06 | 8.2 KB | 257 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Event Driven Programming Example"
   Height          =   4110
   Left            =   1305
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3705
   ScaleWidth      =   4515
   Top             =   1545
   Width           =   4635
   Begin CommandButton CmdVerify
      Caption         =   "Verify Sort"
      Height          =   495
      Left            =   2160
      TabIndex        =   7
      Top             =   3120
      Width           =   2175
   End
   Begin CommandButton CmdQsortBackground
      Caption         =   "QuickSort - Background"
      Height          =   495
      Left            =   2160
      TabIndex        =   9
      Top             =   2520
      Width           =   2175
   End
   Begin CommandButton CmdCancelSort
      Caption         =   "Cancel Sort"
      Height          =   495
      Left            =   840
      TabIndex        =   10
      Top             =   2520
      Width           =   1215
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Interval        =   1
      Left            =   240
      Top             =   2400
   End
   Begin CommandButton CmdQsortNoEvents
      Caption         =   "QuickSort - No Events"
      Height          =   495
      Left            =   2160
      TabIndex        =   8
      Top             =   1920
      Width           =   2175
   End
   Begin CommandButton CmdSrchBackground
      Caption         =   "SearchEventfully"
      Height          =   495
      Left            =   2160
      TabIndex        =   6
      Top             =   1320
      Width           =   2175
   End
   Begin CommandButton CmdSrchDoEvents
      Caption         =   "SearchWithDoEvents"
      Height          =   495
      Left            =   2160
      TabIndex        =   3
      Top             =   720
      Width           =   2175
   End
   Begin CommandButton CmdSrchNoEvents
      Caption         =   "SearchWithoutEvents"
      Height          =   495
      Left            =   2160
      TabIndex        =   2
      Top             =   120
      Width           =   2175
   End
   Begin Label backlabel
      Alignment       =   2  'Center
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1680
      Width           =   1695
   End
   Begin Label Label2
      Caption         =   "Background Status"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   1320
      Width           =   1695
   End
   Begin Label ResultLabel
      Alignment       =   2  'Center
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   840
      Width           =   1815
   End
   Begin Label Label1
      Caption         =   "Search Result"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   480
      Width           =   1335
   End
' EventCod test program.
' Copyright (c) 1992, by Desaware
' Indicates the operation of timer 1 on this form.
' 0 indicates no operation
' 1 indicates initializing is in progress
' 2 indicates SearchEventfully is in progress
' 3 indicates Background sorting is in progress
Dim TimerMode%
Sub CmdCancelSort_Click ()
    t% = QSortBackground%(-1, 0)
End Sub
Sub CmdQsortBackground_Click ()
    Dim t%
    ' The following line will prevent reentry - Refer
    ' to the article for alternate approaches such
    ' as starting a new sort.
    If TimerMode% Then
        MsgBox "Background operation already in progress"
        Exit Sub
        End If
    t% = QSortBackground%(1, ArraySize%)
    If t% < 0 Then ' Start event driven sorting
        backlabel.Caption = "Sorting"
        CmdCancelSort.Enabled = -1
        TimerMode% = 3
        Timer1.Enabled = -1
    Else
        If t% = 0 Then
            ResultLabel.Caption = "Sorting complete"
        Else
            ResultLabel.Caption = "Sorting cancelled"
            End If
        End If
End Sub
'   Perform a QuickSort without events
Sub CmdQsortNoEvents_Click ()
Dim oldmouseptr%
    oldmouseptr% = Screen.MousePointer
    Screen.MousePointer = 11
    QSortNoEvents 1, ArraySize
    Screen.MousePointer = oldmouseptr%
End Sub
' Search "Eventfully" - i.e. background processing
Sub CmdSrchBackground_Click ()
    Dim r, t%
    ' The following line will prevent reentry - Refer
    ' to the article for alternate approaches such
    ' as starting a new search.
    If TimerMode% = 3 Then
        MsgBox "Background sort in progress"
        Exit Sub
        End If
    ' Ignore command if any other background operation is
    ' in progress
    If TimerMode% Then Exit Sub
    r = Int(Rnd * ArraySize + 1)
    t% = SearchEventfully%(r, -1)
    If t% < 0 Then ' Start event driven initialization
        backlabel.Caption = "Searching"
        TimerMode% = 2
        Timer1.Enabled = -1
    Else ResultLabel.Caption = Str$(t%)
    End If
End Sub
'   Search with DoEvents command
Sub CmdSrchDoEvents_Click ()
    Dim r
    r = Int(Rnd * ArraySize + 1)
    ResultLabel.Caption = Str$(SearchWithDoEvents%(r))
End Sub
' Search without DoEvents command
Sub CmdSrchNoEvents_Click ()
    Dim r
    r = Int(Rnd * ArraySize + 1)
    ResultLabel.Caption = Str$(SearchWithoutEvents%(r))
End Sub
Sub CmdVerify_Click ()
Dim x%
Dim oldmouseptr%
    oldmouseptr% = Screen.MousePointer
    Screen.MousePointer = 11
    For x% = 1 To ArraySize% - 1
        If SampleArray(x%) > SampleArray(x% + 1) Then
            ResultLabel.Caption = "Not Sorted @" + Str$(x%)
            Screen.MousePointer = oldmouseptr%
            Exit Sub
            End If
        Next x%
    ResultLabel.Caption = "Sorted"
    Screen.MousePointer = oldmouseptr%
End Sub
Sub Form_Load ()
    Dim t%
    Randomize
    t% = LoadSampleArray()
    If t% Then ' Start event driven initialization
        ' Don't allow sorting during initialization!
        CmdQsortNoEvents.Enabled = 0
        CmdQsortBackground.Enabled = 0
        ' The cancel sort command is disabled to start
        CmdCancelSort.Enabled = 0
        backlabel.Caption = "Initializing"
        TimerMode% = 1
        Timer1.Enabled = -1
    End If
End Sub
'   We use the timer to keep background operations
'   operating properly.
'   This algorithm allows only one background operation
'   at a time.  See article text for ideas how maintaining
'   multiple concurrent operations.
Sub Timer1_Timer ()
    Dim t%, u%
    Select Case TimerMode%
        Case 1  ' Background initialization
                t% = LoadSampleArray%()
                If Not t% Then  ' We're done!
                    TimerMode% = 0
                    Timer1.Enabled = 0
                    backlabel.Caption = "Idle"
                    CmdQsortNoEvents.Enabled = -1
                    CmdQsortBackground.Enabled = -1
                End If
        Case 2  ' Background searching
                t% = SearchEventfully%(0, 0)
                If t% >= 0 Then ' We're done!
                    TimerMode% = 0
                    Timer1.Enabled = 0
                    ResultLabel.Caption = Str$(t%)
                    backlabel.Caption = "Idle"
                End If
        Case 3  ' Background sorting
                ' The sort granularity is set here
                For u% = 1 To 20
                    t% = QSortBackground%(0, 0)
                    If t% >= 0 Then Exit For
                    Next u%
                If t% >= 0 Then ' We're done!
                    CmdCancelSort.Enabled = 0
                    TimerMode% = 0
                    Timer1.Enabled = 0
                    backlabel.Caption = "Idle"
                    If t% = 0 Then
                        ResultLabel.Caption = "Sorting complete"
                    Else
                        ResultLabel.Caption = "Sorting cancelled"
                        End If
                    End If
    End Select

End Sub